home *** CD-ROM | disk | FTP | other *** search
/ Developer Helper 1: Phil & Dave's Excellent CD / Excellent CD HFS.raw / Moof / DAs, INITs, CDEVs, etc / ShowSICN / showSICN.p < prev   
Text File  |  1989-04-02  |  2KB  |  95 lines
  1.  
  2. UNIT RotateKCHR;
  3.  
  4. INTERFACE
  5.  
  6. uses
  7. MemTypes, QuickDraw, OSIntf, ToolIntf,PackIntf, Script;
  8.  
  9. PROCEDURE RotateKCHRs;
  10.  
  11. IMPLEMENTATION
  12.  
  13. PROCEDURE SetSICN; FORWARD;
  14.  
  15. PROCEDURE RotateKCHRs;
  16. VAR
  17.     keyresult: Longint;
  18.     scriptsinstalled: Longint;
  19.     newscript: Longint;
  20.     theType: ResType;
  21.     name: Str255;
  22.     theID: integer;
  23.     I: integer;
  24.     err: OSerr;
  25.     appscript: longint;
  26.     totalKCHR: integer;
  27.     KCHRHdl: Handle;
  28.  
  29. BEGIN
  30.     SetSICN;
  31.     scriptsinstalled := GetEnvirons(smEnabled);  {how many scripts?}
  32.     
  33.     IF scriptsinstalled > 1 THEN     {more than roman}
  34.         appscript := GetEnvirons(smKeyScript)   {so we need to get the current script}
  35.     ELSE
  36.         appscript := smRoman;
  37.         
  38.     {get all the current KCHR resource}
  39.     keyresult := GetScript(appscript,smScriptKeys);
  40.     
  41.     {now cycle through the available KCHRs}
  42.     totalKCHR := CountResources('KCHR');
  43.     
  44.     
  45.     I := 1;
  46.     REPEAT
  47.         SetResLoad(FALSE);    {don't load the resources while we check}
  48.         KCHRhdl := GetIndResource('KCHR',I);
  49.         I := I + 1;
  50.         GetResInfo(KCHRhdl,theID,theType,name);
  51.     UNTIL (I > totalKCHR) OR ( theID = keyresult );
  52.     
  53.     
  54.     IF ( I > totalKCHR ) THEN
  55.         theID := 1
  56.     ELSE
  57.         theID := I;
  58.         
  59.     {we are ready to really load it}
  60.     SetResLoad(TRUE);    {don't load the resources while we check}
  61.     KCHRhdl := GetIndResource('KCHR',theID);
  62.     GetResInfo(KCHRhdl,theID,theType,name);  {and get info on it}
  63.  
  64.     IF theID >= $4000 THEN    {it doesn't belong to Roman}
  65.         newscript := ((theID - $4000) DIV 512) +1  {what script does it belong to?}
  66.     ELSE
  67.         newscript := smRoman;
  68.         
  69.     IF newscript <> appscript THEN BEGIN  {we have to switch scripts too}
  70.         err := SetEnvirons(smKeyScript,newscript);
  71.         appscript := newscript;
  72.     END;
  73.     
  74.     {now change the KCHR}
  75.     err := SetScript(appscript,smScriptKeys,theID);
  76.     err := SetScript(appscript,smScriptIcon,theID);
  77.     KeyScript(appscript);
  78.         
  79. END;
  80.  
  81. PROCEDURE SetSICN;
  82. VAR
  83.     SICNstate: Longint;
  84.     err: Oserr;
  85.     
  86. BEGIN
  87.     SICNstate := GetEnvirons(smGenFlags);
  88.     BSET(SICNstate,smfShowIcon);
  89.     
  90.     err := SetEnvirons(smGenFlags,SICNstate);
  91.     DrawMenuBar;
  92. END;
  93.  
  94. END.
  95.